(defpackage :guide
  (:use :cl)
  ;;(:nicknames :g)
  (:export :get-selection
           :get-all-selections
           :operation-for-selection
           :basic-fill-in-instructions))

(in-package :guide)

(defun get-selection (tree operations)
  "Return selections for an operation that will work on TREE."
  (dolist (o operations)
    (multiple-value-bind (node trans vars selections-needed)
        (o:find-transformation-for tree (o:transformations o) t)
      (declare (ignore vars))
      (when node
        (return (values selections-needed o trans))))))

(defun get-all-selections (tree operations)
  (let (node trans vars selection-needed)
    (declare (ignorable trans vars))
    (loop for o in operations
       do (multiple-value-setq (node trans vars selection-needed)
            (o:find-transformation-for tree (o:transformations o) t))
       when node
       collect (list o selection-needed))))

(defun basic-fill-in-instructions (tree)
  "Return the basic instructions for TREE."
  (labels ((click-the (loc thing)
             (format nil "Click the ~a green box and type ~a." (string-downcase loc) thing))
           (input-args (tree)
             (let (acc)
               (d:funcall-on-tree (lambda (n)
                                    (when (typep n 'd:input-argument)
                                      (push n acc)))
                                tree)
               acc)))
    (let ((args (input-args tree)))
      (case (length args)
        (1 (format nil "Click the green box and type ~a." (d:answer (first args))))
        (2 (let (top bottom)
             (if (< (geom:y (first args))
                    (geom:y (second args)))
                 (setf top (first args)
                       bottom (second args))
                 (setf bottom (first args)
                       top (second args)))
             (list (click-the :top (d:answer top))
                   (click-the :bottom (d:answer bottom)))))
        (3 (let* ((top (first (sort (copy-list args) '< :key 'geom:y)))
                  (bot (first (sort (copy-list args) '> :key 'geom:y)))
                  (mid (car (set-difference args (list top bot)))))
             ;; FIXME: is there ever a top most box?
             (list (click-the :top (d:answer top))
                   (click-the :middle (d:answer mid))
                   (click-the :bottom (d:answer bot)))))
        (4 (let* ((top (first (sort (copy-list args) '< :key 'geom:y)))
                  (bot (first (sort (copy-list args) '> :key 'geom:y)))
                  (right (first (sort (copy-list args) '> :key 'geom:x)))
                  (mid (car (set-difference args (list top bot right)))))
             ;; FIXME: is there ever a top most box?
             (list (click-the :top (d:answer top))
                   (click-the :right (d:answer right))
                   (click-the :middle (d:answer mid))
                   (click-the :bottom (d:answer bot)))))
        (t (error "I don't know how to do ~d input arguments" (length args)))))))

(defun operation-for-selection (tree operations)
  "Return an operation that can be applied to the selected boxes."
  (loop for o in operations
       for trans = (second (multiple-value-list (o:find-transformation-for tree (o:transformations o))))
       when trans return (values o trans)))

(defun next-input-argument (tree)
  "Return the next argument that should be filled in based on some
rules."
  (let* ((empty-args (d:collect-on-tree (lambda (n)
                                          (and (typep n 'd:input-argument)
                                               (null (d:quantity n))))
                                        tree))
         (filled-args (d:collect-on-tree (lambda (n)
                                           (and (typep n 'd:input-argument)
                                                (d:quantity n)
                                                (not (string= (d:quantity n) (u:string2 (d:answer n))))))
                                         tree)))
    (or (first (sort filled-args '> :key 'geom:y))
        (first (sort empty-args '> :key 'geom:y)))))

(defun fill-instructions-for-arg (arg)
  "Return the hint and mistake text for ARG. arg must be an input-argument."
  (values
   (if (slot-boundp arg 'd:hint)
       (d:hint arg)
       (format nil "Move the mouse into this box and enter ~a." (d:answer arg)))
   (cond
     ((and (slot-boundp arg 'd:mistake)
           (d:mistake arg)
           (d:quantity arg)
           (d:valid-input-p arg (d:quantity arg))
           (not (string= (d:quantity arg) (u:string2 (d:answer arg)))))
      (u:nl (d:mistake arg)))
     ((and (d:quantity arg)
           (d:valid-input-p arg (d:quantity arg)))
      (format nil "~a is not the right answer." (d:quantity arg)))
     ;; FIXME: invalid input is displayed elsewhere
     (t nil))))

(defun arg-fill-in-instructions (tree)
  (let ((arg (next-input-argument tree)))
    (when arg
      (values-list (cons arg
                         (multiple-value-list (fill-instructions-for-arg arg)))))))
